home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / DDPLUS71 / RIPLINK.ZIP / DDPLUSR.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-14  |  42KB  |  1,797 lines
  1.  
  2. unit DDPlusR;
  3. {$V-,F+}
  4.  
  5. interface
  6. uses dos, crt, comio, ddscott, ddansi2, ddovr, ddovr2, RipLink;
  7. type
  8.  CharOriginType=(localchar,remotechar);
  9.  strptr=^string;
  10.  RIPtr = ^RIPObject;
  11.     RIPObject = object(RIPObj)
  12.     procedure sendstr(instr : string); virtual;
  13.     procedure sendstrcr(instr : string); virtual;
  14.   end;
  15. const
  16.  version= 'Version 7.10  ; 05-13-95';
  17.  
  18.  progname: string[60] = 'Another DDPlus 7.1 Door Game';
  19.  graphics_codes: array[1..5] of string[4] = ('','.ASC','.ANS','.MUS','.ANS');
  20.  { You will have to make up your mind to have item #5 .ANS or .RIP.  You may }
  21.  { find that displaying a ripfile is more effectively done if shown some     }
  22.  { other day.                                                                }
  23.  
  24.  ack=#6;
  25.  nak=#21;
  26.  sot=#1;
  27. var
  28.  DoRip:Boolean;                     {Do local RIP?}
  29.  RIP           : RIPtr; {an instance of the object}
  30.  lockbaud: longint;                 {lock baud rate                          }
  31.  com1,com2,com3,com4 : byte;        { temporary non-std comports             }
  32.  port1,port2,port3,port4:word;
  33.  irq1,irq2,irq3,irq4 : byte;
  34.  fossilIO,DigiIO: boolean;          {from .CTL file: fossil, digiboard i/o   }
  35.  com_port: byte;                    {from DROP FILE: com port                }
  36.  mintime: byte;                     {Minimum time left before user kicked off}
  37.  notime: string;                    {Out of time filename                    }
  38.  macro,macro_str: string;           {Used in the macro routines              }
  39.  node_num: byte;                    {Node number                             }
  40.  time_credit: integer;              {Time credit +/- (arrow keys)            }
  41.  CharOrigin: CharOrigInType;        {Where character came from               }
  42.  fouled_up: char;                   {Internal use                            }
  43.  localcol: boolean;                 {From .CTL file: Local color enabled     }
  44.  ansion: boolean;                   {Process ANSI locally                    }
  45.  time_check: boolean;               {Check time left - halt if < mintime     }
  46.  moreok : boolean;                  {display <more> prompt?                  }
  47.  curlinenum: integer;               {current line num - used by <more>       }
  48.  stacked: string;                   {used internally - stacked commands      }
  49.  F1toggel: byte;                    {Show Help or Status Line                }
  50.  inchat  : byte;                    {Already inchat don't do this again      }
  51.  current_foreground: byte;          {current foreground color                }
  52.  current_background: byte;          {current background color                }
  53.  color_chg: boolean;                {send ANSI color change sequences?       }
  54.  default_fore: byte;                {default foreground color                }
  55.  default_back: byte;                {default background color                }
  56.  cdropped,tdropped: boolean;        {carrier dropped? timedropped            }
  57.  bbs_time_left: integer;            {from DROP FILE: time left               }
  58.  bbs_software: byte;                {from .CTL file: bbs type                }
  59.  baud_rate: longint;                {from DROP FILE: baud rate               }
  60.  statfore,statback: byte;           {status line foreground                  }
  61.  statline: boolean;                 {status line background                  }
  62.  graphics: byte;                    {from DROP FILE: graphics code           }
  63.  local: boolean;                    {from DROP FILE: local mode              }
  64.  user_number: word;           {from DROP FILE: user's access level     }
  65.  user_first_name: string[30];       {from DROP FILE: user's first name       }
  66.  user_last_name: string[30];        {from DROP FILE: user's last name        }
  67.  sysop_first_name: string[30];      {from .CTL file: sysop's first name      }
  68.  sysop_last_name: string[30];       {from .CTL file: sysop's last name       }
  69.  board_name: string[70];            {from .CTL file: board name              }
  70.  Pause_Code : string;
  71.  st_hr, st_mn, st_sc,save_sc: word;         {used by timer calculations              }
  72.  color1: boolean;                   {from .CTL file: color1 mode             }
  73.  EMSOK : boolean;                   {/E use ems memory                     }
  74.  NetOK : boolean;                   {A Dos only network is present           }
  75.  NoLocal : boolean;                 { Local echo turned off (statback)       }
  76.  stackon: boolean;                  {process stacked commands?               }
  77.  badchar: string;                   {internal use                            }
  78.  maxtime: word;                     {from .CTL file: maximum time in door    }
  79.  user_access_level: word;
  80.  numlines: byte;                    {from .CTL file: number of lines/screen  }
  81.  oldtextmode: word;                 {original text mode                      }
  82.  GoRip      : byte;                 { enables force RIP }
  83.  lastsetfore: byte;                 {last set_foreground color               }
  84.  setforecheck: boolean;             {check repetetive set_foreground calls?  }
  85.  dropfilepath: string;              {from parm list                          }
  86.  cc          : integer;             { read cycle counter                     }
  87.  soutput: text;                     {Simultanious output file                }
  88.  proc_call_ptr: pointer;            {used internally                         }
  89.  nodirect: boolean;
  90.  
  91. Procedure DV_Aware_On;
  92. Procedure DV_Pause;
  93. Procedure Win_Pause;
  94. Procedure ReleaseTimeSlice;
  95. procedure close_async_port;
  96. procedure open_async_port;
  97. function  skeypressed: boolean;
  98. Procedure Clear_Region(x,a,b:byte);
  99. procedure sendtext(s: string);
  100. procedure sgoto_xy(x,y: integer);
  101. procedure sclrscr;
  102. procedure sclreol;
  103. procedure swrite(s: string);
  104. procedure swritec(ch: char);
  105. procedure swriteln(s: string);
  106. Procedure swritexy(x,y:integer;s:string);
  107. Procedure Propeller(v:byte);
  108. procedure sread_char(var ch: char);
  109. procedure sread(var s: string);
  110. procedure sread_num(var n: integer);
  111. procedure sread_num_byte(var b: byte);
  112. procedure sread_num_longint(var n: longint);
  113. Procedure speedread(var ch : char);
  114. function time_left: integer;
  115. procedure set_foreground(f: byte);
  116. procedure set_background(b: byte);
  117. procedure set_color(f,b: byte);
  118. procedure prompt(var s: string; le: integer; pc: boolean);
  119. Procedure elapsed(time1_hour, time1_min, time1_sec, time2_hour, time2_min,
  120.                   time2_sec: longint; var elap_hour, elap_min, elap_sec: word);
  121. procedure get_stacked(var s: string);
  122. procedure sread_char_filtered(var ch: char);
  123. procedure display_status;
  124. Procedure Displayfile(filen: string);
  125. Procedure SelectAnsi(chflag :char;filenm: string);
  126. procedure DDAssignSoutput(var f: text);
  127. procedure InitDoorDriver(ConfigFileName: string);
  128. function Time_used: integer;
  129.  
  130. Implementation
  131. {$L DVAWARE.OBJ}
  132.  
  133. Procedure DV_Aware_On;       External;
  134. Procedure DV_Pause;          External;
  135.  
  136. var
  137.  buffered: boolean;
  138.  exitsave: pointer;
  139.  tcolor,bcolor: integer;
  140.  firsttime: boolean;
  141.  
  142. { This releases the virtual machine time slice for MSwindows, Dos 5.0, OS/2 }
  143.  
  144. procedure Dos_Sleep;
  145. var
  146.  Regs : Registers;
  147. begin
  148.  with Regs do
  149.    Intr($28,Regs);
  150. end;
  151.  
  152. procedure Win_Pause;
  153. var
  154.  Regs : Registers;
  155. begin
  156.  with Regs do
  157.  begin
  158.    Ax := $1680;
  159.    Intr($2F,Regs);
  160.  end;
  161. end;
  162.  
  163. Procedure ReleaseTimeSlice;
  164. begin
  165.   Case Tasker of
  166.     1    : DV_Pause;
  167.     2..5 : Win_Pause;
  168.   else
  169.     Dos_Sleep;
  170.   end;
  171. end;
  172.  
  173. Procedure Clear_Region(x,a,b:byte);
  174. var
  175.   i : byte;
  176. begin
  177.   for i := a to b do
  178.     begin
  179.       SGoto_XY(x,i);
  180.       Sclreol;
  181.     end;
  182. end;
  183.  
  184. Procedure Chat_Eof(flag:byte);
  185. begin
  186.   If wherey =24 then
  187.     begin
  188.       Clear_Region(1,19,21);
  189.       SGoto_XY(1,19);
  190.       Swrite('»');
  191.     end
  192.   else
  193.   if flag=1 then
  194.     swriteln('');
  195.   If wherey=22 then
  196.     begin
  197.       Clear_Region(1,22,24);
  198.       Sgoto_XY(1,22);
  199.     end;
  200. end;
  201.  
  202. { This is the old continous rolling chat                           }
  203. {
  204. procedure forced_chat;
  205. var
  206.  cx,cy:byte;
  207.  ch: char;
  208.  a: integer;
  209.  old_origin: charorigintype;
  210.  word: string;
  211.  lastspace: integer;
  212. begin;
  213.  swriteln('');
  214.  set_foreground(lightred);
  215.  swriteln('Chat mode enabled. ESC exits.');
  216.  set_foreground(lightblue);
  217.  old_origin:=localchar;
  218.  lastspace:=0;
  219.  word:='';
  220.  repeat;
  221.   sread_char(ch);
  222.   if charorigin<>old_origin then if charorigin=localchar then set_foreground(lightblue) else set_foreground(yellow);
  223.   old_origin:=charorigin;
  224.   swrite(ch);
  225.   if ch=#8 then begin;
  226.    swrite(' '+#8);
  227.    if length(word)>0 then delete(word,1,1);
  228.   end;
  229.   if ch=#13 then begin;
  230.    swrite(#10);
  231.    lastspace:=0;
  232.    word:='';
  233.   end;
  234.   if (ch<>' ') and (ch<>#8) and (ch<>#13) then word:=word+ch;
  235.   if ch=' ' then begin;
  236.    lastspace:=wherex;
  237.    word:='';
  238.   end;
  239.   if wherex>75 then begin;
  240.    if lastspace=0 then begin;
  241.     swriteln('');
  242.    end else begin;
  243.     while wherex>lastspace do swrite(#8+' '+#8);
  244.     swriteln('');
  245.     swrite(word);
  246.    end;
  247.   end;
  248.  until ch=#27;
  249.  set_foreground(default_fore);
  250. end;
  251. }
  252. { This is the new formated chat that uses lines 19-24 for a chat   }
  253. { window that rolls from 19-24 and back again.                     }
  254.  
  255. procedure forced_chat;
  256. var
  257.   i,x,y,cx,cy,oldy:byte;
  258.   ch: char;
  259.   a: integer;
  260.   old_origin: charorigintype;
  261.   word: string;
  262.   lastspace: integer;
  263.  
  264. begin;
  265.   SGoto_XY(1,19);
  266.   Set_Color(0,6);
  267.   swrite(' The SYSOP wants to chat with you.       [ESC] to exit.');
  268.   Sclreol;
  269.   Set_Color(7,0);
  270.   Clear_Region(1,20,24);
  271.   SGoto_XY(1,20);
  272.   Swrite('»');
  273.   set_foreground(11);
  274.   old_origin:=localchar;
  275.   lastspace:=0;
  276.   word:='';
  277.  
  278.   repeat;
  279.   sread_char(ch);
  280.   if charorigin<>old_origin then
  281.     if charorigin=localchar then
  282.       set_foreground(11)
  283.     else
  284.       set_foreground(14);
  285.   old_origin:=charorigin;
  286.   swrite(ch);
  287.   if ch=#8 then
  288.     begin
  289.       swrite(' '+#8);
  290.       if length(word)>0 then
  291.         delete(word,1,1);
  292.     end;
  293.  
  294.   if ch=#13 then
  295.    begin
  296.      if wherey >23 then
  297.        Chat_Eof(0)
  298.      else
  299.       begin
  300.        swrite(#10);
  301.         if wherey =22 then
  302.           Chat_Eof(0);
  303.        swrite('»');
  304.       end;
  305.      lastspace:=0;
  306.      word:='';
  307.    end;
  308.  
  309.   if (ch<>' ') and (ch<>#8) and (ch<>#13) then
  310.     word:=word+ch;
  311.   if ch=' ' then
  312.     begin
  313.      lastspace:=wherex;
  314.      word:='';
  315.     end;
  316.  
  317.   if wherex>75 then
  318.     begin
  319.      if lastspace=0 then
  320.         Chat_Eof(1)
  321.      else
  322.        begin
  323.          while wherex>lastspace do swrite(#8+' '+#8);
  324.          Chat_Eof(1);
  325.          swrite(word);
  326.        end;
  327.     end;
  328.   until ch=#27;
  329.   Set_Color(7,0);
  330.   Clear_Region(1,19,24);
  331. end;
  332.  
  333. Procedure DropMessage;
  334. begin;
  335.    writeln;
  336.    writeln('Carrier Dropped, returning to BBS.');
  337.    cdropped:=true;
  338.    halt;
  339. end;
  340.  
  341. procedure BlankScreenMessage;
  342. begin
  343.   gotoxy (trunc((80-length(progname))/2),10);
  344.   write(progname);
  345.   gotoxy (26,12);
  346.   write('Local screen mode turned off.');
  347.   gotoxy (1,1);
  348. end;
  349.  
  350. Procedure HosedMessage;
  351. begin
  352.   Swriteln('');
  353.   Swriteln('');
  354.   Set_Color(15,0);
  355.   Swrite('The SYSOP has terminated the game and is returning you to the BBS!');
  356.   ReleaseTimeSlice;
  357.   delay(500);
  358.   ReleaseTimeSlice;
  359. end;
  360.  
  361. procedure textcolor(i: byte);
  362. begin;
  363.  if localcol then crt.textcolor(i);
  364.  tcolor:=i;
  365. end;
  366.  
  367. procedure textbackground(i: byte);
  368. begin;
  369.  if localcol then crt.textbackground(i);
  370.  bcolor:=i;
  371. end;
  372.  
  373. procedure elapsed(time1_hour, time1_min, time1_sec, time2_hour, time2_min,
  374.                   time2_sec: longint; var elap_hour, elap_min, elap_sec: word);
  375. var
  376.  a,b,c: longint;
  377. begin;
  378.  if time1_hour<time2_hour then time1_hour:=time1_hour+24;
  379.  a:=(time1_hour*3600)+(time1_min*60)+time1_sec;
  380.  b:=(time2_hour*3600)+(time2_min*60)+time2_sec;
  381.  c:=a-b;
  382.  if c>=3600 then elap_hour:=c div 3600 else elap_hour:=0;
  383.  c:=c-((c div 3600)*3600);
  384.  if c>=60 then elap_min:=c div 60 else elap_min:=0;
  385.  c:=c-((c div 60)*60);
  386.  elap_sec:=c;
  387. end;
  388.  
  389. function time_left: integer;
  390. var
  391.  hour, minute, second, sec100: word;
  392.  el_hr, el_mn, el_sc: word;
  393. begin;
  394.  gettime(hour, minute, second, sec100);
  395.  elapsed(hour, minute, second, st_hr, st_mn, st_sc, el_hr, el_mn, el_sc);
  396.  time_left:=time_credit+(bbs_time_left-((el_hr*60)+el_mn));
  397. end;
  398.  
  399. function time_used: integer;
  400. var
  401.  hour, minute, second, sec100: word;
  402.  el_hr, el_mn, el_sc: word;
  403. begin;
  404.  gettime(hour, minute, second, sec100);
  405.  elapsed(hour, minute, second, st_hr, st_mn, st_sc, el_hr, el_mn, el_sc);
  406.  time_used:=(el_hr*60)+el_mn;
  407. end;
  408.  
  409. procedure display_Fkeys;
  410. var
  411.  a,b: integer;
  412.  x,y: integer;
  413. begin;
  414.  x:=wherex;
  415.  y:=wherey;
  416.  cursoroff;
  417.  window(1,1,80,numlines);
  418.  a:=tcolor;
  419.  b:=bcolor;
  420.  textcolor(statfore);
  421.  textbackground(statback);
  422.  gotoxy(1,numlines);
  423.  clreol;
  424.  write(' F1=Help Toggel │ F2=Chat │ F7=+5Min │ F8=-5Min │ F10=Eject │');
  425. {while(wherex<80) do
  426.   write(' '); }
  427.  window(1,1,80,numlines-1);
  428.  gotoxy(x,y);
  429.  textcolor(a);
  430.  textbackground(b);
  431.  If Not NoLocal then cursoron;
  432.  if f1toggel=0 then
  433.   f1toggel:=1
  434.  else
  435.   begin
  436.     firsttime:=true;
  437.     f1toggel:=0
  438.   end;
  439.  
  440. end;
  441.  
  442. procedure display_status;
  443. var
  444.  a,b: integer;
  445.  c,d: word;
  446.  x,y: integer;
  447.  hour, minute, second, sec100, el_mn, el_hr, el_sc: word;
  448.  s,o : string;
  449. begin;
  450.  x:=wherex;
  451.  y:=wherey;
  452.  cursoroff;
  453.  window(1,1,80,numlines);
  454.  a:=tcolor;
  455.  b:=bcolor;
  456.  textcolor(statfore);
  457.  textbackground(statback);
  458.  
  459.  if firsttime then
  460.    begin
  461.      FillChar(s,80,' ');
  462.      s[0]:=#79;
  463.      Insert(user_first_name+' '+user_last_name,s,1);
  464.      o:=progname+' - Node '+va(node_num);
  465.      Insert(o,s,(40-(length(o) div 2)));
  466.      firsttime:=false;
  467.      save_sc:=999;
  468.      If DoRip then
  469.       Begin
  470.         RIP^.StatText := s;
  471.         RIP^.StatLine;
  472.       End
  473.      else
  474.       Begin
  475.         gotoxy(1,numlines);
  476.         clreol;
  477.         write(s);
  478.       End;
  479.    end;
  480.  gettime(hour,minute,second,sec100);
  481.  elapsed(hour,minute,second,st_hr,st_mn,st_sc,el_hr,el_mn,el_sc);
  482.  c:=(bbs_time_left-1)+time_credit;
  483.  if (time_left<mintime) and (time_check) then
  484.    begin
  485.      cursoron;
  486.      if notime<>'' then swriteln('(*** Time limit exceeded ***)');
  487.      swriteln('');
  488.      tdropped:=true;
  489.      halt;
  490.    end;
  491.  c:=c-((el_hr*60)+el_mn);
  492.  d:=60-el_sc;
  493.  If save_sc<>d then
  494.   begin
  495.    If DoRip then
  496.     Begin
  497.       str(c,s);
  498.       s:=s+':';
  499.       str(d,o);
  500.       if d<10 then
  501.        o:='0'+o;
  502.       s:=s+o+'  ';
  503.       Insert(s, RIP^.StatText, 74);
  504.       RIP^.StatLine;
  505.       save_sc:=d;
  506.     End
  507.    else
  508.     Begin
  509.       gotoxy(74,numlines);
  510.       clreol;
  511.       gotoxy(74,numlines);
  512.       write(c,':');
  513.       if d<10 then write('0');
  514.       write(d);
  515.      End;
  516.   End;
  517.  textcolor(a);
  518.  textbackground(b);
  519.  window(1,1,80,numlines-1);
  520.  gotoxy(x,y);
  521.  If Not NoLocal then cursoron;
  522.  
  523. end;
  524.  
  525. procedure Selectansi;
  526. var
  527.   f: text;
  528.   b,g,counter,chcount : integer;
  529.   c,quit: boolean;
  530.   k,ch: char;
  531.   ansisave,moresave,swon : boolean;
  532.   ofm: word;
  533. begin
  534.   ofm:=filemode;
  535.   filemode:=66;
  536.   ansisave:=ansion;
  537.   ansion:=true;
  538.   quit:=false;
  539.   counter:=1;
  540.   chcount:=0;
  541.   c:=false;
  542.   swon:=false;
  543.   g:=graphics;
  544.   k:=' ';
  545.  
  546.   assign(f,'ERROR');
  547.   if pos('.',filenm)<>0 then assign(f,filenm) else
  548.    begin
  549.      while (g>=0) and (not c) do
  550.        begin
  551.          if exist(filenm+graphics_codes[g]) then
  552.            begin
  553.              assign(f,filenm+graphics_codes[g]);
  554.              c:=true;
  555.            end;
  556.          dec(g);
  557.        end;
  558.    end;
  559.  
  560.  {$I-}
  561.  filemode:=66;
  562.  reset(f);
  563.  filemode:=66;
  564.  {$I+}
  565.  if ioresult<>0 then
  566.    begin
  567.      swriteln('File '+filenm+' missing');
  568.      ansion:=ansisave;
  569.      filemode:=ofm;
  570.      exit;
  571.    end;
  572.  
  573.  while (not eof(f)) and (not quit) do
  574.   begin
  575.     if ch=#10 then
  576.       begin
  577.         chcount:=0;
  578.         inc(counter);
  579.       end;
  580.  
  581.     read(f,ch);
  582.     if chcount>0 then
  583.       begin
  584.         if swon then
  585.            swritec(ch);
  586.       end
  587.     else
  588.       begin
  589.         if swon then
  590.           begin
  591.             if ch<>chflag then
  592.               quit:=true;
  593.           end
  594.         else
  595.         if ch=chflag then
  596.           swon:=true;
  597.       end;
  598.     inc(chcount);
  599.    end;
  600.  
  601.    close(f);
  602.    ansion:=ansisave;
  603.    set_foreground(default_fore);
  604.    filemode:=ofm;
  605. end;
  606.  
  607. procedure displayfile;
  608. var
  609.   f: text;
  610.   g, counter,b: integer;
  611.   c,quit,nonstop: boolean;
  612.   k,ch: char;
  613.   ansisave,moresave: boolean;
  614.   ofm: word;
  615. begin
  616.   ofm:=filemode;
  617.   filemode:=66;
  618.   ansisave:=ansion;
  619.   ansion:=true;
  620.   nonstop:=false;
  621.   quit:=false;
  622.   counter:=1;
  623.   c:=false;
  624.   g:=graphics;
  625.   k:=' ';
  626.   assign(f,'ERROR');
  627.   if pos('.',filen)<>0 then assign(f,filen) else
  628.    begin
  629.      while (g>=0) and (not c) do
  630.        begin
  631.          if exist(filen+graphics_codes[g]) then
  632.            begin
  633.              if g in [2,3,5] then
  634.                nonstop:=true;
  635.              assign(f,filen+graphics_codes[g]);
  636.              c:=true;
  637.            end;
  638.          dec(g);
  639.        end;
  640.    end;
  641.  {$I-}
  642.  filemode:=66;
  643.  reset(f);
  644.  filemode:=66;
  645.  {$I+}
  646.  if ioresult<>0 then
  647.    begin
  648.      swriteln('File '+filen+' missing - please inform sysop');
  649.      ansion:=ansisave;
  650.      filemode:=ofm;
  651.      exit;
  652.    end;
  653.  while (not eof(f)) and (not quit) do
  654.   begin
  655.     if ch=#10 then inc(counter);
  656.  {  if (counter=24) and (not nonstop) then
  657.       begin
  658.         counter:=1;
  659.         swrite('Continue,Stop,Non-stop ? ');
  660.         sread_char(ch);
  661.         for b:=1 to 26 do
  662.           swrite(chr(8));
  663.         clreol;
  664.        if ch in ['S','s'] then
  665.          Quit:=true;
  666.        if ch in ['N','n'] then
  667.          nonstop:=true;
  668.       end; }
  669.     { remove the comments to implement the pause function }
  670.  
  671.     read(f,ch);
  672.     if skeypressed then
  673.       sread_char(k);
  674.     if k=^S then
  675.       sread_char(k);
  676.     if (k=^k) or (k=^c) then
  677.       begin
  678.         close(f);
  679.         AsyncPurgeOutput;
  680.         swriteln('');
  681.         ansion:=ansisave;
  682.         filemode:=ofm;
  683.         exit;
  684.       end;
  685.     if not quit then
  686.       swritec(ch);
  687.    end;
  688.  
  689.    close(f);
  690.    ansion:=ansisave;
  691.    set_foreground(default_fore);
  692.    filemode:=ofm;
  693. end;
  694.  
  695. procedure SendText(s: string);
  696. var
  697.  a: integer;
  698. begin;
  699.  If (Not AsyncCarrierPresent) then DropMessage;
  700.  for a:=1 to length(s) do AsyncSendChar(s[a]);
  701. end;
  702.  
  703. Procedure RIPObject.SendStr(instr : string);
  704. {give RipLink the command to send strings out the modem}
  705. begin
  706.   if not local then sendtext(instr); {SendText is a DDPlus procedure that
  707.                                 sends strings over the modem without
  708.                                 displaying them locally.}
  709. end;
  710.  
  711. Procedure RIPObject.SendStrCR(instr : string);
  712. {give RipLink the command to send strings out the modem}
  713. begin
  714.   if not local then sendtext(instr+#13#10); {SendText is a DDPlus procedure that
  715.                             sends strings over the modem without
  716.                             displaying them locally.}
  717. End;
  718.  
  719. procedure CharOut(ch: char);
  720. begin;
  721.  AsyncSendChar(ch);
  722. end;
  723.  
  724. function charin(var ch: char): boolean;
  725. begin;
  726.  if badchar<>'' then
  727.    begin;
  728.      ch:=badchar[1];
  729.      delete(badchar,1,1);
  730.      charin:=true;
  731.    end
  732.  else
  733.   if AsyncCharPresent then
  734.      begin;
  735.        AsyncReceiveChar(ch);
  736.        charin:=true;
  737.      end
  738.  else charin:=false;
  739. end;
  740.  
  741. procedure CloseDown;
  742. begin;
  743.   if buffered then
  744.      AsyncFlushOutput;
  745.   If Not noFossinit then
  746.      AsyncCloseCom(com_port);
  747.   buffered := false;
  748. end;
  749.  
  750. procedure sclrscr;
  751. begin
  752.  if not local then sendtext(#27'[2J');
  753.  If NoLocal then
  754.    begin
  755.      TextColor(statfore);
  756.      TextBackGround(statback);
  757.    end;
  758.  
  759.  clrscr;
  760.  If NoLocal then BlankScreenMessage;
  761.  curlinenum:=1;
  762.  lastsetfore:=99;
  763. end;
  764.  
  765. procedure sclreol;
  766. begin;
  767.  if not local then sendtext(#27'[K');
  768.  clreol;
  769. end;
  770.  
  771. procedure morecheck;
  772. var
  773.  ch: char;
  774. begin;
  775.  swrite('<More>');
  776.  sread_char(ch);
  777.  swrite(#8+#8+#8+#8+#8+#8);
  778.  write('      ');
  779.  write(#8+#8+#8+#8+#8+#8);
  780. end;
  781.  
  782. procedure swritec(ch: char);
  783. begin;
  784.  if not local then
  785.    AsyncSendChar(ch);
  786.  if NoLocal then
  787.     begin
  788.       gotoxy(Wherex+1,Wherey);
  789.       exit;
  790.     end;
  791.  if ansion then
  792.     ansi_write(ch)
  793.   else
  794.     write(ch);
  795. end;
  796.  
  797. procedure swrite(s: string);
  798. begin;
  799.  if hexon then hexfilt(s);
  800.  if not local then sendtext(s);
  801.  if NoLocal then
  802.   begin
  803.     GotoXY(wherex+length(s),wherey);
  804.     exit;
  805.   end;
  806.  
  807.  if ansion then
  808.      ansi_write_str(s)
  809.  else
  810.     write(s);
  811. end;
  812.  
  813. procedure swriteln(s: string);
  814. begin;
  815.  if hexon then hexfilt(s);
  816.  if not local then sendtext(s+#13+#10);
  817.  if NoLocal then
  818.   begin
  819.     GotoXY(wherex+length(s),wherey);
  820.     writeln;
  821.     exit;
  822.   end;
  823.  
  824.  if ansion then
  825.    begin
  826.      s:=s+#13+#10;
  827.      ansi_write_str(s);
  828.    end
  829.  else
  830.    writeln(s);
  831.  inc(curlinenum);
  832.  if (curlinenum=(numlines-1)) then begin;
  833.   curlinenum:=1;
  834.   if moreok then morecheck;
  835.  end;
  836. end;
  837.  
  838. Procedure swritexy;
  839. begin
  840.  Sgoto_XY(x,y);
  841.  if hexon then hexfilt(s);
  842.  if not local then sendtext(s);
  843.  if NoLocal then
  844.   begin
  845.     GotoXY(wherex+length(s),wherey);
  846.     exit;
  847.   end;
  848.  
  849.  if ansion then
  850.      ansi_write_str(s)
  851.  else
  852.     write(s);
  853. end;
  854.  
  855. Procedure Propeller(v:byte);
  856. const
  857.   CX :array [1..6] of char =(chr(250),'│','/','-','\','?');
  858. var
  859.   b : byte;
  860. begin
  861.   b:=6;
  862.   case v of
  863.    1,15      : b:=1;
  864.    2,6,10,14 : b:=2;
  865.    3,7,11    : b:=3;
  866.    4,8,12    : b:=4;
  867.    5,9,13    : b:=5;
  868.   end;
  869.   if v < 17 then
  870.     begin
  871.       Swritec(cx[b]);
  872.       SwriteC(#8);
  873.     end;
  874. end;
  875.  
  876. procedure DDexit;
  877. begin;
  878.  If DoRip then
  879.   if RIP <> nil then
  880.    Dispose(RIP, Done);
  881.  If not local then CloseDown;
  882.  if lastmode<>oldtextmode then textmode(oldtextmode);
  883.  cursoron;
  884.  { This should fix the problem OS/2 serial IO drivers are having exiting. }
  885.  exitproc:=exitsave;
  886. end;
  887.  
  888.  { Customize this for each game }
  889.  
  890. Procedure CallProc;
  891. inline($FF/$1E/Proc_Call_Ptr);
  892.  
  893. Procedure DefineFKeys(var a:char;fkeyon:byte);
  894. begin
  895.   a:=#0;
  896.   case fkeyon of
  897.     1: Display_Fkeys;
  898.     2: begin
  899.          if inchat>0 then exit;
  900.          inchat:=1;
  901.          Forced_Chat;
  902.          inchat:=0;
  903.          a:=#3;
  904.        end;
  905.     7: inc(time_credit,5);
  906.     8: dec(time_credit,5);
  907.    10: begin
  908.          HosedMessage;
  909.          Halt;
  910.        end;
  911.   end;
  912. end;
  913.  
  914. procedure sfkeys(var a: char);
  915. var
  916.  fkeyon:byte;
  917. begin
  918.   fkeyon:=0;
  919.    case a of
  920.      #59:fkeyon:=1;
  921.      #60:fkeyon:=2;
  922.      #61:fkeyon:=3;
  923.      #62:fkeyon:=4;
  924.      #63:fkeyon:=5;
  925.      #64:fkeyon:=6;
  926.      #65:fkeyon:=7;
  927.      #66:fkeyon:=8;
  928.      #67:fkeyon:=9;
  929.      #68:fkeyon:=10;
  930.   else
  931.      a:=#0;
  932.   end;
  933.   If a<>#0 then
  934.     DefineFkeys(a,fkeyon);
  935. end;
  936.  
  937. Procedure ReadScanCode(var a:char);
  938. begin
  939.   a :=readkey;
  940.   if (a=#0) and (keypressed) then
  941.     begin;
  942.       a:=readkey;
  943.       sFkeys(a);
  944.     end;
  945. end;
  946.  
  947. {ccc}
  948. procedure sread_ch(var ch: char);
  949. var
  950.  a: char;
  951.  i : integer;
  952. begin;
  953.  cc:=0;
  954.  a:=#0;
  955.  ch:=#0;
  956.  charorigin:=localchar;
  957.  
  958.  repeat;
  959.   If DoRip then
  960.    if RIP<>nil then
  961.     RIP^.CheckMouse;
  962.  
  963.   if not local then
  964.     begin
  965.       If (Not AsyncCarrierPresent) then DropMessage;
  966.       if charin(a) then charorigin:=remotechar;
  967.     end;
  968.  
  969.   if keypressed then
  970.     ReadScanCode(a);
  971.  
  972.   If (a=#0) then
  973.    If DoRip then
  974.     if RIP<>nil then
  975.      if RIP^.CharInBuffer then
  976.        a:=RIP^.Getnextchar;
  977.  
  978.   If (a<>#0) then
  979.     ch := a
  980.   else
  981.   If cc mod 100 = 99 then
  982.     ReleaseTimeSlice;
  983.  
  984.   inc(cc);
  985.  
  986.   if statline then
  987.     begin;
  988.        if cc=1 then display_status;
  989.        if cc>1000 then cc:=0;
  990.     end;
  991.   until ch<>#0;
  992. end;
  993.  
  994. procedure sread_char(var ch: char);
  995. var
  996.  ch1,ch2: char;
  997. begin;
  998.  curlinenum:=1;
  999.  repeat;
  1000.   if macro<>'' then
  1001.     begin;
  1002.       ch:=macro[1];
  1003.       delete(macro,1,1);
  1004.     end
  1005.   else
  1006.     repeat;
  1007.     ch:=#0;
  1008.     if fouled_up<>#0 then
  1009.       begin;
  1010.         ch:=fouled_up;
  1011.         fouled_up:=#0;
  1012.       end
  1013.     else
  1014.       begin;
  1015.         sread_ch(ch1);
  1016.         if ch1=^N then
  1017.           begin;
  1018.             ch1:=#1;
  1019.             macro:=macro_str;
  1020.           end;
  1021.  
  1022. {       delay(20);
  1023.         if (ch1=#27) and skeypressed then
  1024.           begin;
  1025.             sread_ch(ch2);
  1026.             if ch2='[' then
  1027.               begin;
  1028.                 sread_ch(ch2);
  1029.                 if (ch2 in ['1'..'9']) and (skeypressed) then
  1030.                   sread_ch(ch2);
  1031.                 case ch2 of
  1032.                    'A' : ch:=^E;
  1033.                    'B' : ch:=^X;
  1034.                    'C' : ch:=^D;
  1035.                    'D' : ch:=^S;
  1036.                 end;
  1037.               end
  1038.             else
  1039.               begin;
  1040.                 ch:=ch1;
  1041.                 fouled_up:=ch2;
  1042.               end;
  1043.            end
  1044.          else
  1045.   }
  1046.            ch:=ch1;
  1047.         end;
  1048.   until ch<>#0;
  1049.  until ch<>#1;
  1050. end;
  1051.  
  1052. procedure sread_char_filtered(var ch: char);
  1053. begin;
  1054.  sread_char(ch);
  1055.  if ch in [#1..#7,#10..#12,#14..#31,#127..#255] then ch:='.';
  1056. end;
  1057.  
  1058. procedure get_stacked(var s: string);
  1059. var
  1060.  s2: string;
  1061.  a: integer;
  1062.  b: boolean;
  1063. begin;
  1064.  s:='';
  1065.  s2:='';
  1066.  b:=false;
  1067.  if length(stacked)=0 then begin;
  1068.   s:='';
  1069.   exit;
  1070.  end;
  1071.  for a:=1 to length(stacked) do begin;
  1072.   if stacked[a]=';' then b:=true else if not b then s:=s+stacked[a];
  1073.   if b then s2:=s2+stacked[a];
  1074.  end;
  1075.  if length(s2)>=1 then delete(s2,1,1);
  1076.  stacked:=s2;
  1077. end;
  1078.  
  1079. procedure sread(var s: string);
  1080. var
  1081.  ch: char;
  1082.  hexsave: boolean;
  1083. begin;
  1084.  hexsave:=hexon;
  1085.  hexon:=false;
  1086.  curlinenum:=1;
  1087.  s:='';
  1088.  get_stacked(s);
  1089.  if s<>'' then swrite(s) else begin;
  1090.   repeat;
  1091.    sread_char_filtered(ch);
  1092.    if (ch<>#8) and (ch<>^M) then begin;
  1093.     s:=s+ch;
  1094.     swrite(ch);
  1095.    end;
  1096.    if (ch=chr(8)) and (length(s)>0) then begin;
  1097.     delete(s,length(s),1);
  1098.     swrite(chr(8)+' '+chr(8));
  1099.    end;
  1100.   until (ch=^M);
  1101.   if (pos(';',s)<>0) and (stackon) then begin;
  1102.    stacked:=s;
  1103.    get_stacked(s);
  1104.   end;
  1105.  end;
  1106.  swriteln('');
  1107.  hexon:=hexsave;
  1108.  if hexon then hextodec(s);
  1109. end;
  1110.  
  1111. procedure sread_num(var n: integer);
  1112. var
  1113.  x,y,code: integer;
  1114.  s: string;
  1115.  ch: char;
  1116. begin;
  1117.  sread(s);
  1118.  val(s,n,x);
  1119. end;
  1120.  
  1121. procedure sread_num_byte(var b: byte);
  1122. var
  1123.  x,y,code: integer;
  1124.  s: string;
  1125.  ch: char;
  1126. begin;
  1127.  sread(s);
  1128.  val(s,b,x);
  1129. end;
  1130.  
  1131. procedure sread_num_longint(var n: longint);
  1132. var
  1133.  x,y,code: integer;
  1134.  s: string;
  1135.  ch: char;
  1136. begin;
  1137.  sread(s);
  1138.  val(s,n,x);
  1139. end;
  1140.  
  1141.  { Speed read is a one time read of the comport.  What I have used it for }
  1142.  { is part of another routine that reads for a number of seconds.  Here   }
  1143.  { the caller must enter all his commands or info in that time allotment. }
  1144.  { They cannot delay a multi-node game by not inputting a command.        }
  1145.  
  1146.  
  1147. Procedure SpeedRead(var ch : char);
  1148. var
  1149.   a : char;
  1150. begin
  1151.   inc(cc);
  1152.   if statline then
  1153.     begin;
  1154.        if cc=1 then display_status;
  1155.        if cc>1000 then cc:=0;
  1156.     end;
  1157.  
  1158.   ch := #0;
  1159.   a := #0;
  1160.   If local then
  1161.     begin
  1162.       If KeyPressed then
  1163.         ReadScanCode(a);
  1164.       If (a<>#0) then
  1165.         ch := a
  1166.       else
  1167.       If cc mod 100 = 99 then
  1168.          ReleaseTimeSlice;
  1169.       exit;
  1170.     end;
  1171.  
  1172.   charorigin:=localchar;
  1173.   If (Not AsyncCarrierPresent) then DropMessage;
  1174.  
  1175.   if charin(a) then
  1176.     charorigin:=remotechar
  1177.   else
  1178.   If KeyPressed then
  1179.      ReadScanCode(a);
  1180.  
  1181.   If (a<>#0) then
  1182.     ch := a
  1183.   else
  1184.   If cc mod 100 = 99 then
  1185.     ReleaseTimeSlice;
  1186. end;
  1187.  
  1188. function va(i: integer): string;
  1189. var
  1190.  s: string;
  1191. begin;
  1192.  str(i,s);
  1193.  va:=s;
  1194. end;
  1195.  
  1196. procedure set_foreground;  { f : byte }
  1197. const
  1198.   colorf: array[0..7] of integer = (30,34,32,36,31,35,33,37);
  1199.   colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  1200. var
  1201.  s,sb : string;
  1202. begin;
  1203.  if f > 31 then exit;
  1204.  if (f = current_foreground) then exit;
  1205.  if Not NoLocal then textcolor(f);
  1206.  
  1207.  if not local then
  1208.    begin
  1209.    if (f=7) and (current_background=0) then
  1210.        sendtext(#27+'[0m')
  1211.    else
  1212.    begin
  1213.    If current_background = 0 then
  1214.      sb := ''
  1215.    else
  1216.      sb := ';'+va(colorb[current_background]);
  1217.    case f of
  1218.      0..7  :  begin
  1219.                 s := va(colorf[f]);
  1220.                 case current_foreground of
  1221.                 { 0..7  : s := s;  }
  1222.                   8..31 : s := '0;'+s+sb;
  1223.                end;
  1224.             end;
  1225.      8..15 : begin
  1226.                s := va(colorf[f-8]);
  1227.                case current_foreground of
  1228.                   0..7  : s := '1;'+s;
  1229.               {   8..15 : s := s; }
  1230.                  16..31 : s := '0;1;'+s+sb;
  1231.                end;
  1232.              end;
  1233.     16..23 : begin
  1234.                s := va(colorf[f-16]);
  1235.                case current_foreground of
  1236.                   0..7  : s := '5;'+s;
  1237.                   8..15,
  1238.                { 16..23 : s := s; }
  1239.                  24..31 : s := '0;5;'+s+sb;
  1240.                end;
  1241.             end;
  1242.     24..31 : begin
  1243.                s := va(colorf[f-24]);
  1244.                 case current_foreground of
  1245.                   0..7  : s := '1;5;'+s;
  1246.                   8..15 : s := '5;'+s;
  1247.                  16..23 : s := '1;'+s;
  1248.               {  24..31 : s := s; }
  1249.                 end;
  1250.             end;
  1251.      end;
  1252.        sendtext(#27+'['+s+'m');
  1253.     end;
  1254.   end;
  1255.   current_foreground:=f;
  1256. end;
  1257.  
  1258. procedure set_background;  { b : byte }
  1259. const
  1260.  colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  1261. begin;
  1262.  if b > 7 then exit;
  1263.  if (b = current_background) then exit;
  1264.  if Not NoLocal then textbackground(b);
  1265.  current_background:=b;
  1266.  if not local then
  1267.     if (current_foreground=7) and (b=0) then
  1268.        sendtext(#27+'[0m')
  1269.     else
  1270.        sendtext(#27+'['+va(colorb[b])+'m');
  1271. end;
  1272.  
  1273. Procedure Set_Color;     { f,b : byte }
  1274. const
  1275.   colorf: array[0..7] of integer = (30,34,32,36,31,35,33,37);
  1276.   colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
  1277. var
  1278.  f1:byte;
  1279.  s:string;
  1280.  NoBackG_Ok : boolean;
  1281. begin
  1282.  if (f>31) or (b>7) then exit;
  1283.  if (f=current_foreground) and (b=current_background) then exit;
  1284.  if (f<>current_foreground) and (b<>current_background) then
  1285.     begin
  1286.       if Not NoLocal then
  1287.         begin
  1288.           textcolor(f);
  1289.           textbackground(b);
  1290.         end;
  1291.       If not local then
  1292.          If (f=7) and (b=0) then
  1293.             sendtext(#27+'[0m')
  1294.          else
  1295.          begin
  1296.           s := '[';
  1297.           NoBackG_OK := false;
  1298.           case f of
  1299.             0..7  : begin
  1300.                       f1:=f;
  1301.                       case current_foreground of
  1302.                       { 0..7  : s := s;  }
  1303.                         8..31 : begin
  1304.                                   s := s+'0;';
  1305.                                   NoBackG_OK := true;
  1306.                                 end;
  1307.                       end;
  1308.                     end;
  1309.             8..15 : begin
  1310.                       f1:=f-8;
  1311.                       case current_foreground of
  1312.                         0..7  : s := s+'1;';
  1313.                     {   8..15 : s := s; }
  1314.                        16..31 : begin
  1315.                                   s := s+'0;1;';
  1316.                                   NoBackG_OK := true;
  1317.                                 end;
  1318.                       end;
  1319.                     end;
  1320.            16..23 : begin
  1321.                       f1:=f-16;
  1322.                       case current_foreground of
  1323.                         0..7  : s := s+'5;';
  1324.                         8..15,
  1325.                      { 16..23 : s := s; }
  1326.                        24..31 : begin
  1327.                                   s := s+'0;5;';
  1328.                                   NoBackG_OK := true;
  1329.                                 end;
  1330.                      end;
  1331.                    end;
  1332.           24..31 : begin
  1333.                      f1:=f-24;
  1334.                      case current_foreground of
  1335.                         0..7  : s := s+'1;5;';
  1336.                         8..15 : s := s+'5;';
  1337.                        16..23 : s := s+'1;';
  1338.                     {  24..31 : s := s; }
  1339.                      end;
  1340.                    end;
  1341.          end;
  1342.          If NoBackG_OK and (b=0) then
  1343.            sendtext(#27+s+va(colorf[f1])+'m')
  1344.          else
  1345.            sendtext(#27+s+va(colorf[f1])+';'+va(colorb[b])+'m');
  1346.       end;
  1347.       current_foreground:=f;
  1348.       current_background:=b;
  1349.     end
  1350.      else
  1351.      if (f<>current_foreground) then
  1352.         set_foreground(f)
  1353.      else
  1354.        set_background(b);
  1355. end;
  1356.  
  1357. procedure prompt;
  1358. const
  1359.  promptcol1=7;
  1360.  promptcol2=1;
  1361.  promptcol3=15;
  1362. var
  1363.  fg,bg: integer;
  1364.  x,y,code: integer;
  1365.  ch: char;
  1366.  a: integer;
  1367.  hexsave: boolean;
  1368. begin;
  1369.  hexsave:=hexon;
  1370.  hexon:=false;
  1371.  fg:=current_foreground;
  1372.  bg:=current_background;
  1373.  get_stacked(s);
  1374.  if s<>'' then begin;
  1375.   set_foreground(promptcol3);
  1376.   while length(s)>le do delete(s,length(s),1);
  1377.   swrite(s);
  1378.   set_foreground(fg);
  1379.  end else begin;
  1380.   if not color_chg then pc:=false;
  1381.   if pc then begin;
  1382.    set_foreground(promptcol1);
  1383.    set_background(promptcol2);
  1384.    for a:=1 to le do swrite(' ');
  1385.    for a:=1 to le do swrite(#8);
  1386.    x:=wherex;
  1387.    y:=wherey;
  1388.   end;
  1389.   s:='';
  1390.   repeat;
  1391.    sread_char_filtered(ch);                                 { read(kbd,ch);}
  1392.    if (ch<>#8) and (ch<>^M) and (length(s)<le) then begin;
  1393.     s:=s+ch;
  1394.     swrite(ch);                                    { write(ch);}
  1395.    end;
  1396.    if length(s)>200 then delete(s,1,1);
  1397.    if (ch=chr(8)) and (length(s)>0) then begin;
  1398.     delete(s,length(s),1);
  1399.     swrite(chr(8));                                { write(#8,' ',#8);}
  1400.     swrite(' ');
  1401.     swrite(#8);
  1402.    end;
  1403.   until (ch=^M) or (length(s)=999);
  1404.   if pc then begin;
  1405.    set_foreground(promptcol3);
  1406.    set_background(bg);
  1407.    while wherex>x do swrite(#8);
  1408.    swrite(s);                                      { write(s);}
  1409.    while wherex<x+le do swrite(' ');               { write(' ');}
  1410.    set_foreground(fg);
  1411.   end;
  1412.   swriteln('');                                    { writeln('');}
  1413.   if pos(';',s)<>0 then begin;
  1414.    stacked:=s;
  1415.    get_stacked(s);
  1416.    while length(s)>le do delete(s,length(s),1);
  1417.   end;
  1418.  end;
  1419.  hexon:=hexsave;
  1420. end;
  1421.  
  1422. procedure sgoto_xy;
  1423. var
  1424.  s,s2: string;
  1425. begin;
  1426.  gotoxy(x,y);
  1427.  curlinenum := y;
  1428.  s:=#27+'[';
  1429.  str(y,s2);
  1430.  s:=s+s2;
  1431.  str(x,s2);
  1432.  s:=s+';'+s2+'f';
  1433.  if not local then sendtext(s);
  1434. end;
  1435.  
  1436. function skeypressed: boolean;
  1437. var
  1438.  b: boolean;
  1439. begin;
  1440.  b:=false;
  1441.  if not local then b:=AsyncCharPresent;
  1442.  if not b then b:=keypressed;
  1443.  if macro<>'' then b:=true;
  1444.  skeypressed:=b;
  1445. end;
  1446.  
  1447. procedure close_async_port;
  1448. begin;
  1449.  if buffered then begin;
  1450.    buffered:=false;
  1451.    AsyncFlushOutput;
  1452.    AsyncCloseUp;
  1453.  end;
  1454. end;
  1455.  
  1456. procedure open_async_port;
  1457. begin;
  1458.  AsyncSelectPort(com_port);
  1459.  if lockbaud=0 then
  1460.   AsyncSetBaud(baud_rate)
  1461.  else
  1462.   AsyncSetBaud(lockbaud);
  1463.  buffered := true;   { Not set in original DD - this may not be the best }
  1464.                      { place for this but it does work in my tests       }
  1465. end;
  1466. {
  1467.   }
  1468. var
  1469.  nclastchar: char;
  1470.  
  1471. function NewCrtOutPut(var f: textrec): integer;
  1472. var
  1473.  p: integer;
  1474. begin;
  1475.  for p:=0 to f.bufpos-1 do swrite(f.bufptr^[p]);
  1476.  f.bufpos:=0;
  1477.  NewCrtOutPut:=0;
  1478. end;
  1479.  
  1480. function NewCrtInPut(var f: textrec): integer;
  1481. var
  1482.  p: integer;
  1483.  ch: char;
  1484. begin;
  1485.  with f do begin;
  1486.   p:=0;
  1487.   if nclastchar=#13 then begin; nclastchar:=' '; end else repeat;
  1488.    ch:=readkey;
  1489.    nclastchar:=ch;
  1490.    write(ch);
  1491.    bufptr^[p]:=ch;
  1492.    inc(p);
  1493.    if ch=#13 then write(#10);
  1494.    if ch=#8 then begin;
  1495.     write(' '#8);
  1496.     if p>0 then dec(p);
  1497.     if p>0 then dec(p);
  1498.    end;
  1499.   until (p=bufsize-1) or (ch=#13);
  1500.   bufpos:=0;
  1501.   bufend:=p;
  1502.  end;
  1503.  NewCrtInput:=0;
  1504. end;
  1505.  
  1506. function NewCrtIgnore(var f: textrec): integer;
  1507. begin;
  1508.  newcrtignore:=0;
  1509. end;
  1510.  
  1511. function NewCRTOpen(var f: textrec): integer;
  1512. begin;
  1513.  if f.mode=fmInput then begin;
  1514.   f.inoutfunc:=@NewCrtInput;
  1515.   f.flushfunc:=@NewCrtIgnore;
  1516.  end else begin;
  1517.   f.mode:=fmOutput;
  1518.   f.inoutfunc:=@NewCrtOutPut;
  1519.   f.flushfunc:=@NewCrtOutPut;
  1520.  end;
  1521.  NewCrtOpen:=0;
  1522. end;
  1523.  
  1524. Function RipDetect: boolean;
  1525. var
  1526.   i,j,k : integer;
  1527.   a : char;
  1528.   s : string;
  1529.   RipYes : boolean;
  1530. begin
  1531.  RipYes := false;
  1532.  If local then
  1533.    begin
  1534.      RipDetect := RipYes;
  1535.      exit;
  1536.    end;
  1537.  
  1538.  sendtext(#27+'[0;30m'+#13+#10);
  1539.  writeln;
  1540.  writeln('Checking for RIP');
  1541.  sendtext(#27'[!');
  1542.  delay(222);
  1543.  s := '';
  1544.  i := 0;
  1545.  j := 0;
  1546.  charorigin:=localchar;
  1547.  repeat;
  1548.  
  1549.    a:=chr(0);
  1550.    inc(i);
  1551.  
  1552.   If (Not AsyncCarrierPresent) then DropMessage;
  1553.  
  1554.   if charin(a) then
  1555.     charorigin:=remotechar;
  1556.   if (a<>chr(0)) then
  1557.     begin
  1558.       s := s+a;
  1559.       inc(j);
  1560.     end
  1561.   else
  1562.      begin
  1563.        If (i mod 50 = 0) then
  1564.          ReleaseTimeSlice;
  1565.      end;
  1566.   delay(2);
  1567.   until (i>666) or (j>13);
  1568.  
  1569.   If Copy(s,1,3) = 'RIP' then
  1570.     begin
  1571.       RipYes := true;
  1572.       writeln('Rip Detected');
  1573.       if charin(a) then
  1574.          charorigin:=remotechar;
  1575.     end;
  1576.  RipDetect := RipYes;
  1577.  Swriteln('');
  1578. end;
  1579.  
  1580. procedure DDAssignSOutput(var f: text);
  1581. begin;
  1582.  with textrec(f) do begin;
  1583.   handle   := $FFFF;
  1584.   mode     := fmclosed;
  1585.   bufsize  := sizeof(buffer);
  1586.   bufptr   := @buffer;
  1587.   OpenFunc := @NewCrtOpen;
  1588.   CloseFunc:= @NewCrtIgnore;
  1589.   Name[0]  := #0;
  1590.  end;
  1591. end;
  1592.  
  1593. Procedure StatusMess(var fs:string);
  1594. begin
  1595.   Set_Color(2,0);
  1596.   Case Tasker of
  1597.     1 : writeln('DESQview Detected');
  1598.     2 : writeln('Windows 3.xx Detected');
  1599.     3 : writeln('OS/2 Detected');
  1600.     4 : writeln('Win/NT Detected');
  1601.     5 : writeln('Dos 5.0 with Network Detected');
  1602.     6 : writeln('Dos 5.0+ Detected');
  1603.   else
  1604.         writeln('No Multiplexer Detected');
  1605.   end;
  1606.   If FossilIO or DigiIO then
  1607.    begin
  1608.       Set_Foreground(10);
  1609.       writeln(fs);
  1610.    end;
  1611.   Set_Color(7,0);
  1612.   ReleaseTimeSlice;
  1613. end;
  1614.  
  1615. procedure InitDoorDriver(ConfigFileName: string);
  1616. Var
  1617.  i,a: byte;
  1618.  b: integer;
  1619.  junk: word;
  1620.  fossilstr:string;
  1621. begin;
  1622.  initddansi;
  1623.  oldtextmode:=lastmode;
  1624.  lastsetfore:=99;
  1625.  setforecheck:=false;
  1626.  badchar:='';
  1627.  ansion:=false;
  1628.  moreok:=false;
  1629.  numlines:=25;
  1630.  cc:=0;
  1631.  F1toggel:=0;
  1632.  Inchat:=0;
  1633.  clrscr;
  1634.  window(1,1,80,numlines-1);
  1635.  node_num:=1;
  1636.  statfore:=7;
  1637.  statback:=1;
  1638.  com_port:=0;
  1639.  fouled_up:=#0;
  1640.  stacked:='';
  1641.  fossilstr:='';
  1642.  digiio:=false;
  1643.  fossilio:=false;
  1644.  hexon:=false;
  1645.  buffered:=false;
  1646.  cdropped:=false;
  1647.  tdropped:=false;
  1648.  exitsave:=exitproc;
  1649.  exitproc:=@DDexit;
  1650.  firsttime:=true;
  1651.  
  1652.  RIP := nil;     {clears pointer (to object)}
  1653.  DoRip:=false;
  1654.  GoRip := 0;
  1655.  
  1656.  LoadPorts(port1,port2,port3,port4,irq1,irq2,irq3,irq4);
  1657.  Loadconfig( ConfigFileName,
  1658.              bbs_software,
  1659.              user_first_name,user_last_name,
  1660.              user_access_level,
  1661.              bbs_time_left,
  1662.              com_port,
  1663.              baud_rate,
  1664.              node_num,
  1665.              local,
  1666.              graphics,
  1667.              color1,
  1668.              color_chg,
  1669.              NoFossInit,
  1670.              board_name,
  1671.              pause_code,
  1672.              sysop_first_name,
  1673.              sysop_last_name,
  1674.              maxtime,
  1675.              localcol,
  1676.              statfore,
  1677.              statback,
  1678.              statline,
  1679.              EMSOK,NetOK,
  1680.              nolocal,
  1681.              fossilio,
  1682.              digiio,
  1683.              dropfilepath,
  1684.              GoRip,
  1685.              lockbaud,
  1686.              nodirect,
  1687.              port1,port2,port3,port4,irq1,irq2,irq3,irq4);
  1688.  
  1689.  numlines:=25;
  1690.  if nodirect then directvideo:=false;
  1691.  clrscr;
  1692.  window(1,1,80,numlines-1);
  1693.  textcolor(7);
  1694.  textbackground(0);
  1695.  default_fore:=7;
  1696.  default_back:=0;
  1697.  gettime(st_hr,st_mn,st_sc,junk);
  1698.  
  1699.  GetBBSInfo( bbs_software,
  1700.              user_first_name,user_last_name,
  1701.              user_access_level,
  1702.              bbs_time_left,
  1703.              com_port,
  1704.              baud_rate,
  1705.              node_num,
  1706.              local,
  1707.              graphics,
  1708.              color1,
  1709.              color_chg,
  1710.              board_name,
  1711.              sysop_first_name,
  1712.              sysop_last_name,
  1713.              maxtime,
  1714.              dropfilepath,
  1715.              lockbaud);
  1716.  
  1717.  ReSetPorts(port1,port2,port3,port4,irq1,irq2,irq3,irq4);
  1718.  if not local then
  1719.    begin;
  1720.     if FossilIO then AsyncSelectFossil(fossilstr) else
  1721.      if DigiIO then AsyncSelectDigiBoard(fossilstr) else
  1722.       AsyncSelectInternal;
  1723.     Open_Async_Port;
  1724.    end;
  1725.  
  1726.  if not local then
  1727.   if not initok then
  1728.    begin
  1729.      writeln('');
  1730.      if fossilio then
  1731.       begin
  1732.         writeln('Fossil was not initialized properly! You should change to INTERNAL');
  1733.         writeln('communications routines.');
  1734.       end
  1735.     else
  1736.     if digiio then
  1737.       begin
  1738.         writeln('DigiDriver was not initialized properly!');
  1739.       end;
  1740.     delay(3000);
  1741.     halt;
  1742.   end;
  1743.  
  1744.  If Graphics <> 5 then
  1745.    If RipDetect then
  1746.      Graphics := 5;
  1747.  
  1748.  If (GoRip = 4) and Local then
  1749.    Graphics:=5;
  1750.  
  1751.  If (Graphics=5) then
  1752.    Begin
  1753.      If GoRip=4 then
  1754.        DoRip:=True
  1755.      Else
  1756.        DoRip:=False;
  1757.      New(RIP,Init(DoRIP,''));
  1758.    End;
  1759.  
  1760. {
  1761.  If (GoRip = 4) and (Local or (Graphics=5)) then
  1762.   Begin
  1763.    RIP := nil;
  1764.    DoRip:=True;
  1765.    New(RIP,Init(DoRIP,''));
  1766.    graphics := 5;
  1767.   End;            }
  1768.  
  1769.  DV_Aware_ON;
  1770.  current_foreground:=default_fore;
  1771.  current_background:=default_back;
  1772.  if graphics = 3 then
  1773.    begin
  1774.      set_foreground(statfore);
  1775.      set_background(statback);
  1776.    end;
  1777.  curlinenum:=1;
  1778.  time_check:=true;
  1779.  time_credit:=0;
  1780.  macro_str:='';
  1781.  macro:='';
  1782.  mintime:=1;
  1783.  notime:='';
  1784.  user_first_name:=stu(user_first_name);
  1785.  user_last_name:=stu(user_last_name);
  1786.  stackon:=true;
  1787. {if node_num=0 then node_num:=1; }
  1788.  ddassignsoutput(soutput);
  1789.  rewrite(soutput);
  1790.  If Not NetOk then
  1791.    If (Tasker = 5) then inc(Tasker);
  1792.  StatusMess(fossilstr);
  1793. end;
  1794.  
  1795. end.
  1796.  
  1797.